home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1995 #5 & #6
/
Amiga Plus CD - 1995 - No. 5 and 6.iso
/
pd
/
serien
/
purity
/
nr.10
/
demo
/
sparky.p
< prev
next >
Wrap
Text File
|
1995-04-19
|
13KB
|
638 lines
program Sparky;
{ ****************************************************************************
Sparky, V 1.1, (C) 1993 by Diesel
**************************************************************************** }
{$I "Include:intuition/screens.i"}
{$I "Include:intuition/intuition.i"}
{$I "Include:graphics/view.i"}
{$I "Include:graphics/pens.i"}
{$I "Include:graphics/text.i"}
{$I "Include:exec/libraries.i"}
{$I "Include:libraries/dos.i"}
{$I "Include:libraries/medplayer.i"}
{$I "Include:utils/stringlib.i"}
{ $I "Include:" }
{$I "sparx:vdx.i"}
{$I "sparx:vd1.i"}
{$I "sparx:vd5.i"}
{$I "sparx:vd6.i"}
{$I "sparx:vd7.i"}
{$I "sparx:pic.i"}
Const
lz : String = " ";
MaxColors = 32;
MaxLines = 32;
NS : NewScreen = (0,0,320,256, 5, 0,0, 0,
CustomScreen_f, NIL,NIL,NIL,NIL );
VAR
ActualSpot : Short;
ColCnt : Short;
Type
Spot = Record
x,y : Short;
End;
Line = Record
x1,y1,
x2,y2 : Short;
End;
LinePtr = ^Line;
LineArray = Array[1..MaxLines] of Line;
LineArrayPtr = ^LineArray;
ColorArray = Array[0..MaxColors-1] of Short;
ColorArrayPtr = ^ColorArray;
SinCosArray = Array[0..680] of Short; { 628 + Reserve }
SinCosArrayPtr = ^SinCosArray;
Const
Def_Colors : ColorArray = ($0000, $0fff, $0f00, $0f30,
$0f60, $0f90, $0fc0, $0ff0,
$0cf0, $09f0, $06f0, $03f0,
$00f0, $00f3, $00f6, $00f9,
$00fc, $00ff, $00cf, $009f,
$006f, $003f, $000f, $030f,
$060f, $090f, $0c0f, $0f0f,
$0f0c, $0f09, $0f06, $0f03);
GreenMap : ColorArray = ($0000, $0f00, $0040, $0080,
$00a0, $00b0, $00a0, $0080,
$0040, $0044, $0088, $00aa,
$00bb, $00aa, $0088, $0044,
$0440, $0880, $0aa0, $0bb0,
$0aa0, $0880, $0440, $0400,
$0800, $0a00, $0b00, $0c00,
$0b00, $0a00, $0800, $0400);
Var
GfxBase : Address;
Xsin,
XCos : SinCosArrayPtr;
flt : Real;
i : Integer;
Work32cols : ColorArrayPtr;
VP : ViewPortPtr;
VW : ViewPtr;
RP : RastPortPtr;
WB,
Scr : ScreenPtr;
module : MMD0Ptr;
{ -------------------------------------------- }
Function InitSong: Boolean;
Var
void : Integer;
Begin
MEDPlayerBase := OpenLibrary( medname, 0 );
if MEDPlayerBase = NIL then InitSong:=False;
module := NIL;
void := GetPlayer(0);
if void = 0 then begin
module := LoadModule("Purity 10:MEDPlayerLibrary/med.turning(avatar)");
If module <> NIL then Begin
PlayModule(module);
Delay(50);
InitSong:=True;
End Else
InitSong:=False;
end else InitSong:=False;
End; { InitSong }
{ -------------------------------------------- }
Procedure ShutUp;
Begin
If Scr <> NIL then CloseScreen( Scr );
If WB <> NIL then begin
For i := 1 to WB^.height do
MoveScreen( WB, 0, -1 );
end;
If module<>NIL then Begin
DimOffPlayer(12);
Delay(100);
UnLoadModule(module);
FreePlayer;
End;
If (MEDPlayerBase <> NIL) then CloseLibrary(MEDPlayerBase);
If (IFFBase <> NIL) then CloseLibrary(IffBase);
If (VecBase <> NIL) then CloseLibrary(VecBase);
If (GfxBase <> NIL) then CloseLibrary(GfxBase);
end; { ShutUp }
{ -------------------------------------------- }
Function dff006 : Short;
Begin
{$A
move.w $dff006,d0
}
End;
Function LeftMouseButton : Boolean;
Begin
{$A
moveq #0,d0
btst #6,$bfe001
bne.s notpressed
pressed:
moveq #-1,d0
notpressed:
}
end;
Procedure ClrScr;
Begin
Move(RP, 0,0);
ClearScreen( RP );
End;
Procedure SetSColors(clarr : Address);
Begin
LoadRGB4( VP, clarr, maxColors );
MakeVPort( VW, VP);
MrgCop( VW );
LoadView( VW );
End;
Procedure Colorsdown;
Var
cnn : ColorArrayPtr;
r,g,b,
i,j,
rest : Short;
Begin
New( cnn );
For i:= 0 to maxColors-1 do
cnn^[i] := Short( GetRGB4( VP^.ColorMap, i ));
For i:=0 to 15 do Begin
For j:=0 to MaxColors-1 do Begin
rest := cnn^[j];
b := rest MOD 16; { In Asm wird natürlich }
rest := rest DIV 16; { einfach nur um 4 bits }
g := rest MOD 16; { nach rechts geshiftet }
rest := rest DIV 16; { ..... }
r := rest MOD 16;
If r > 0 then dec(r);
If g > 0 then dec(g);
If b > 0 then dec(b);
cnn^[j] := (256 * r) + (16 * g) + b;
End;
SetSColors( cnn );
MakeVPort( VW, VP);
MrgCop ( VW );
LoadView ( VW );
Delay(1); { 1/50 sec. warten = smooth }
End;
Dispose( cnn);
End;
Procedure Ciao;
Begin
ColorsDown;
ClrScr;
End;
Procedure DrawLine( xyz : LinePtr; col : Short );
Begin
SetAPen( RP, Byte(col) );
SetDrMd( RP, jam1 );
Move( RP, xyz^.x1, xyz^.y1 );
Draw( RP, xyz^.x2, xyz^.y2 );
End;
Procedure EraseLine( xyz : LinePtr );
Begin
SetBPen( RP, 0 );
SetAPen( RP, 0 );
SetDrMd( RP, jam2 + inversvid );
Move( RP, xyz^.x1, xyz^.y1 );
Draw( RP, xyz^.x2, xyz^.y2 );
End;
Const
bang = 1;
tipp = 2;
fade = 3;
fadeUp = 4;
Procedure ShowText( what : String; col, dy, mode : Short);
Var
x,
buf,
cnt : Short;
begin
x := 160 - 4 * strlen(what);
SetAPen(RP, Byte(col));
Move(RP, x, dy);
{ ---- }
If mode = bang then
GText(RP, what, strlen(what) );
{ ---- }
If (mode = tipp) AND (strlen(What) > 0) then begin
for cnt:=1 to strlen(what) do begin
Move(RP, x, dy);
GText(RP, what, cnt );
Delay(2);
end;
End;
{ ---- }
If mode = fade then begin
SetAPen(RP, 1);
SetRGB4( VP, 1, 0,0,0);
Delay(2);
GText(RP, what, strlen(what) );
For cnt := 1 to 15 do begin
SetRGB4( VP, 1, cnt,cnt,cnt);
Delay(2);
End;
Delay(50);
For cnt := 15 downto 0 do begin
SetRGB4( VP, 1, cnt,cnt,cnt);
Delay(2);
End;
ClrScr;
SetSColors(Adr(Def_Colors));
End;
{ ---- }
If mode = fadeUp then begin
SetRGB4( VP, col, 0,0,0);
Delay(2);
GText(RP, what, strlen(what) );
For cnt := 1 to 15 do begin
SetRGB4( VP, col, cnt,cnt,cnt);
Delay(2);
End;
SetSColors(Adr(Def_Colors));
Delay(20);
End;
End;
{ -------------------------------------------------------------------------- }
{$I "sparx:.spark02.i"}
{$I "sparx:.spark03.i"}
{$I "sparx:.spark04.i"}
{$I "sparx:.spark05.i"}
{$I "sparx:.spark06.i"}
{$I "sparx:.spark07.i"}
{$I "sparx:.spark08.i"}
{$I "sparx:.spark09.i"}
{$I "sparx:.spark10.i"}
{$I "sparx:.spark11.i"}
{$I "sparx:.spark12.i"}
{$I "sparx:.spark12B.i"}
{$I "sparx:.spark13.i"}
{$I "sparx:.spark16.i"}
{$I "sparx:.spark17.i"}
{$I "sparx:.spark18.i"}
{ $I "sparx:.spark20.i"}
{ $I "sparx:.spark19.i"}
Begin
GfxBase := OpenLibrary ("graphics.library",0);
If GfxBase = NIL then Exit(20);
VecBase := OpenLibrary(vecname, 0);
If VecBase = NIL then begin
Write("Cannot open vector.library\n\nKlick!\n");
Repeat until LeftMouseButton;
ShutUp;
end;
IFFBase := OpenLibrary(IFFNAME,18); { -- hier reicht 18 -- }
if IFFBase = NIL then begin
Write("Cannot open iff.library\n\nKlick!\n");
Repeat until LeftMouseButton;
ShutUp;
end;
WB := OpenWorkbench;
If WB <> NIL then begin
For i := 1 to WB^.height do
MoveScreen( WB, 0, 1 );
end;
New(XSin);
New(XCos);
New(Work32cols);
flt := 0.00;
For i:=0 to 680 do Begin
Xsin^[i] := Short( trunc( 100.0 * Sin( flt ) ));
XCos^[i] := Short( trunc( 100.0 * Cos( flt ) ));
flt := flt + 0.01; { Bei 0.09 Abweichung um 0.01 !!!! }
end;
Scr := OpenScreen( Adr( NS ));
If Scr=NIL then ShutUp;
ShowTitle( Scr, False );
RP := Adr( Scr^.SRastPort );
VP := Adr( Scr^.SViewPort );
VW := ViewAddress;
ClrScr;
SetSColors(Adr(Def_Colors));
If NOT InitSong then Begin
ShowText("Sorry - cannot load sound", 0, 100, fade);
End;
ShowText("Klick it !", 3, 120, fadeup);
Repeat
Delay(4);
Until LeftMouseButton;
ClrScr;
Delay(10);
Spark06( Adr(Def_Colors) );
ShowText("Coded 1993 by Diesel", 0, 120, fade);
Spark09;
ShowText("Coded 100% in PCQ-Pascal", 11, 60, tipp);
ShowText("for the Pascal-FD-Serie", 11, 80, tipp);
Delay(100);
ShowText("*** Purity ***", 2, 120, bang);
Delay(100);
ClrScr;
Spark10;
ShowText("Just a little sparking... !", 6, 40, tipp);
Delay(100);
ClrScr;
Spark11;
Spark06( Adr(GreenMap) );
ShowText("& Vectors ....", 2, 80, fadeup);
ClrScr;
Delay(30);
ShowText( VD1, 3, 120, bang); { "alles in pascal" }
Delay(100);
ClrScr;
Spark12;
ShowText("Ursprünglich erschien eine", 2, 40, fadeup);
ShowText("Vorabversion dieser Demo auf", 3, 60, fadeup);
ShowText("der *Amiga-User gegen Rechts*", 4, 80, fadeup);
ShowText("-Disk. Jetzt findet sie sich", 5, 100, fadeup);
ShowText("mit einigen Änderungen und", 6, 120, fadeup);
ShowText("dem kompletten Quellcode auf", 7, 140, fadeup);
ShowText("der Purity ! Also Leute, wer", 8, 160, fadeup);
ShowText("von Euch schreibt die nächste", 9, 180, fadeup);
ShowText("Demo in Pascal ?? ", 10, 200, fadeup);
Delay(50);
ShowText("<klick> ", 11, 240, bang);
Spark12B(27);
Spark02;
ShowText( "Eat it !", 30, 90, fade);
ShowText( ShowPix("Purity 10:demo/pic/pacman.ilbm"), 27, 100, fade);
ClrScr;
ShowText("Die Vector-Animationen habe ich", 11, 20, fadeup);
ShowText("mithilfe der vector.library ein-", 12, 40, fadeup);
ShowText("gebunden. Diese findet sich auch", 13, 60, fadeup);
ShowText("auf einer unserer ersten Puritys.", 14, 80, fadeup);
ShowText("Leider konnte ich bis heute noch", 15, 100, fadeup);
ShowText("keine Docs zu dieser library auf-", 16, 120, fadeup);
ShowText("treiben. Hat jemand von Euch ev.", 17, 140, fadeup);
ShowText("eine zuhause rumliegen ? Dann her", 18, 160, fadeup);
ShowText("damit.(Die v.lib kam, glaube ich,", 19, 180, fadeup);
ShowText("mit der AmigaPlus 11/91.) ", 20, 200, fadeup);
Delay(100);
ShowText("<klick> ", 22, 240, bang);
Spark12B(21);
ShowText("Loose your illusions !", 2, 120, bang);
Delay(50);
ClrScr;
Spark03;
ClrScr;
ShowText( ShowPix("Purity 10:demo/pic/WarDose2.ilbm"), 27, 100, fade);
ClrScr;
ShowText("Man muß sich heutzutage als", 4, 060, tipp);
ShowText("Chemiestudent ja wirklich", 4, 080, tipp);
ShowText("schämen, dieser verrotteten", 4, 100, tipp);
ShowText("Industrie als Kanonenfutter", 4, 120, tipp);
ShowText("zu dienen. ", 4, 140, tipp);
Delay(50);
ClrScr;
ShowText("Ratet mal, wer am Main ", 5, 080, tipp);
ShowText("am meisten rumsaut ?!? ", 5, 100, tipp);
Delay(50);
ShowText("hoechst wahrscheinlich ....", 6, 140, tipp);
Delay(50);
ClrScr;
Delay(20);
ShowText( VD5, 8, 140, tipp);
Delay(100);
ClrScr;
ShowText( ShowPix("Purity 10:demo/pic/Dose.ilbm"), 27, 100, fade);
ClrScr;
ShowText("(20-40-160-320 lines ...)", 25, 200, bang);
Delay(100);
ClrScr;
Spark13;
Work32Cols^[0] := $0000;
For i:=1 to MaxColors-1 do
Work32cols^[i] := i * $0002;
Spark16(Work32Cols);
ShowText("Warum haben wir eigentlich", 23, 60, bang);
ShowText("sowenige aktive Programmierer", 23, 80, bang);
ShowText("im Umkreis der Purity ...?", 23, 100, bang);
Delay(200);
ClrScr;
Spark16(Adr(GreenMap));
ShowText( ShowPix("Purity 10:demo/pic/diesel.ilbm"), 27, 100, fade);
ClrScr;
Spark04;
Delay(30);
ShowText("Endemoniada", 22, 120, fade );
ClrScr;
Work32Cols^[0] := $0000;
For i:=1 to MaxColors-1 do
Work32cols^[i] := Dff006 MOD 4096;
Spark16(Work32Cols);
ShowText("Der Weltraum,unendliche Weiten...", 2, 40, tipp);
Delay(50);
ClrScr;
Delay(10);
ShowText( VD7, 29, 200, fade );
ClrScr;
ShowText("------ Grüße gehen an : -------", 2, 40, tipp);
ShowText("Wurzelsepp, Steppenbrand, Feedy, ", 1, 70, tipp);
ShowText("Kilghard-Wolf, Invisible Power, ", 1, 90, tipp);
ShowText("Funny Future, Norbi, Alex(TuC), ", 1, 110, tipp);
ShowText("Martin, Martin & Sonja, DoIO, ", 1, 130, tipp);
ShowText("Swing, Mozart, Attila, die FreaX ", 1, 150, tipp);
ShowText("aus der InfoX (Read it !), logo, ", 1, 170, tipp);
ShowText("und alle, die ich vergessen habe ",10, 190, tipp);
ShowText("<Klick> ",10, 240, tipp);
Spark12B(8);
Spark17;
ShowText("Greets 2 the avatar - great muzaX!",10, 190, fade);
Spark07( Address(0) );
ShowText("Ach, die vector.library arbeitet", 8, 120, bang);
ShowText("natürlich auch mit Drahtgittern", 8, 140, bang);
Delay(100);
ClrScr;
Delay(20);
ShowText( VD6, 8, 140, bang);
Delay(100);
ClrScr;
ShowText( "Noch von der Anti-Rechts-Disk:", 14, 100, tipp );
Delay(70);
ClrScr;
ShowText( ShowPix("Purity 10:demo/pic/trottel.ilbm"), 5, 100, fade);
ClrScr;
Delay(100);
ClrScr;
Spark18;
Spark05;
ShowText("... dead but dreaming", 0, 220, fade);
Spark07( Adr(Def_Colors) );
ShowText("1 line --klick--> 512 lines", 1, 120, fade);
Spark08;
ShowText("Es sind durchaus mehr möglich", 1, 120, fade);
ShowText("(sieht aber nicht gut aus)", 1, 120, fade);
Spark16( Address(0) );
ShowText("(C)1993 by B. Künnen, 44 MS", 31, 180, tipp);
Spark12B(15);
Work32Cols^[0] := $0000;
for i:= 1 to maxcolors-1 do
Work32cols^[i] := 256 * (Dff006 MOD 16)
+ 16 * (Dff006 MOD 16)
+ (Dff006 MOD 16);
Spark07( Work32Cols );
ShowText("Das soll für heute reichen.", 31, 140, fade);
ShowText("---- Und tschüß ! ----", 31, 140, fade);
ShutUp;
end.